Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Development Platforms/HyperCard Related/XCMDs & XFCNs/HPopUpMenu 1.1/HPopUpMenu.p

Text File | 1991-06-05 | 8.9 KB | 327 lines | [TEXT/MPS ]

{$R-}
{$S HPopUpMenu }

{ HPopUpMenu( MenuItems, InitialItem, Top, Left )

 This HyperCard external function returns the selection from a hierarchical popup
 menu created from a HyperCard item list (the first parameter).  The
 menu is placed on the screen so that the initial item is at the
 position (Top, Left) in global coordinates.

 The MenuItems parameter is a number of lines.  The first line is an item list
 of the names of the items in the first-level menu.  Then, each subsequent line
 is a submenu which will be placed under its corresponding first-menu entry.
 For instance:

 Foo,Bar,Baz
 Foo Item 1,Foo Item 2,Foo Item 3
 Bar Item 1
 Baz Item 1,Baz Item 2

 The return result is a list of two items.  The first item is the number of the
 main menu whose submenu was chosen; the second item is the number of the
 item from within the submenu.

 If the first item of the result is zero, it means that an item was chosen from
 the main menu itself (only possible when that menu had no submenu of its own).
 In this case, the second item of the result is the item number within that menu.

 If the second item of the result is zero, then no choice was made at all.

}

UNIT DummyUnit;

INTERFACE

    USES MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, HyperXCmd, MenuTools;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);

IMPLEMENTATION

    PROCEDURE HPopUpMenu(paramPtr: XCmdPtr);
    FORWARD;

    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
    BEGIN
        HPopUpMenu(paramPtr)
    END { entrypoint } ;


    PROCEDURE HPopUpMenu(paramPtr: XCmdPtr);

    CONST
    FirstMenuID = 128;
    MaxTotalMenus = 50;   {This is arbitrary but FirstMenuID + MaxTotalMenus MUST
                            be less than 235.  i.e. MaxTotalMenus < 107.}

    VAR
    MenuItems:                    Ptr;
    InitialItem:                LONGINT;
    SelectedItem:                LONGINT;
    Top:                        LONGINT;
    Left:                        LONGINT;
    CardWindowTop:                LONGINT;
    CardWindowLeft:                LONGINT;
    FirstLevelSelection:        LONGINT;
    SecondLevelSelection:        LONGINT;
    FirstLevelString:            Str255;
    SecondLevelString:            Str255;

        FUNCTION ParamToNum(Param: Handle): LongInt;

        VAR
            Str: Str255;

        BEGIN
            ZeroToPas(ParamPtr, Param^, Str);
            ParamToNum := StrToNum(ParamPtr, Str);
        END { ParamToNum } ;

        FUNCTION NumToParam(Num: LongInt): Handle;

        VAR
            Str: Str255;

        BEGIN
            NumToStr(ParamPtr, Num, Str);
            NumToParam := PasToZero(ParamPtr, Str)
        END { NumToParam } ;

        PROCEDURE ExitWithMessage(aString:    Str255);
        BEGIN
            WITH paramPtr^ DO BEGIN
                returnValue := PasToZero(ParamPtr, aString);
                EXIT(HPopUpMenu);
            END;
        END;

        PROCEDURE GetCardWindowParams(VAR CardWindowTop: LONGINT;
                                        VAR CardWindowLeft: LONGINT);
        VAR
            WindowTopString:             Handle;
            WindowLeftString:             Handle;
            AString:                    Str255;
        BEGIN

            WindowTopString := EvalExpr(ParamPtr, 'the top of card window');
            WindowLeftString := EvalExpr(ParamPtr, 'the left of card window');
            ZeroToPas(ParamPtr, WindowTopString^, AString);
            CardWindowTop := StrToNum(ParamPtr, AString);

            ZeroToPas(ParamPtr, WindowLeftString^, AString);
            CardWindowLeft := StrToNum(ParamPtr, AString);

            DisposHandle(WindowTopString);
            DisposHandle(WindowLeftString);

        END {GetCardWindowParams} ;

        FUNCTION BeginningOfNextLine(CString: Ptr): Ptr;
        VAR
            MatchString:            Str255;
            ReturnCharStart:        Ptr;
        BEGIN
            MatchString[0] := chr(1);
            MatchString[1] := chr(13);   {MatchString is just a return character.}

            ReturnCharStart := StringMatch(ParamPtr, MatchString, CString);
            IF (ReturnCharStart = NIL) THEN
            BEGIN
                BeginningOfNextLine := NIL;
                Exit(BeginningOfNextLine)
            END;

            {Skip the found return character.}
            BeginningOfNextLine := Ptr(Ord4(ReturnCharStart) + 1);
        END;

        {Returns the number of lines in a CString.}
        FUNCTION NumberOfLinesInPtr(CString: Ptr): LONGINT;
        VAR
            NumLines:    LONGINT;
        BEGIN
            NumLines := 1;
            NumberOfLinesInPtr := NumLines;

            WHILE true DO
            BEGIN
                CString := BeginningOfNextLine(CString);
                IF (CString = NIL) THEN Exit(NumberOfLinesInPtr);
                NumLines := NumLines + 1;
                NumberOfLinesInPtr := NumLines
            END
        END;

        FUNCTION Min(Val1, Val2: INTEGER): INTEGER;
        BEGIN
            IF (Val1 < Val2) THEN Min := Val1 ELSE Min := Val2;
        END;

        PROCEDURE AppendFirstLineMenuItemsPtr(Menu: MenuHandle; MenuItems: Ptr);

        VAR
            StartPos:                LONGINT;
            EndHasBeenReached:        Boolean;
            LengthOfLine:            INTEGER;
            NewLength:                INTEGER;
            PasMenuItems:            Str255;
            NextLinePtr:            Ptr;
        BEGIN

            { The input is a Ptr string (C-style string) containing possibly
              more than 250 characters of menu items to be added to the list.
              We break the input up into 250 character chunks as many times as possible,
              calling AppendAllMenuItems on each chunk. Items past the first return
              character will be ignored.}

            StartPos := 0;
            EndHasBeenReached := false;

            REPEAT

                ZeroToPas(ParamPtr, Pointer(Ord4(MenuItems) + StartPos), PasMenuItems);
                NewLength := length(PasMenuItems);

                NextLinePtr := BeginningOfNextLine(Pointer(Ord4(MenuItems) + StartPos));

                IF (NextLinePtr <> NIL) THEN
                    BEGIN
                        LengthOfLine := Ord4(NextLinePtr) - (Ord4(MenuItems) + StartPos) - 1;
                        NewLength := Min(NewLength,LengthOfLine)
                    END;


                IF (NewLength > 250) THEN
                    BEGIN
                        FOR NewLength := 250 DOWNTO 1 DO
                            IF (PasMenuItems[NewLength] = ',') THEN Leave;
                        NewLength := NewLength - 1;
                    END
                ELSE
                    EndHasBeenReached := true;

                IF (NewLength) <= 0 THEN Exit(AppendFirstLineMenuItemsPtr);
                PasMenuItems[0] := chr(NewLength);
                AppendAllMenuItems(Menu, PasMenuItems);
                StartPos := StartPos + NewLength + 1

            UNTIL (EndHasBeenReached = true);

        END { AppendFirstLineMenuItemsPtr } ;

        PROCEDURE DoHPopUpMenuPtr(FirstMenuID: INTEGER; MenuItems: Ptr; InitialItem: LONGINT;
                            Top: LONGINT; Left: LONGINT;
                            VAR FirstLevelSelection: LONGINT;
                            VAR SecondLevelSelection: LONGINT);
        VAR
        Menu:                    MenuHandle;
        TheMenus:                PACKED ARRAY [1..MaxTotalMenus] of MenuHandle;
        TotalNumberOfMenus:        INTEGER;
        MenuIndex:                INTEGER;
        NextItemsLine:            Ptr;
        PopupResult:            LONGINT;
        SelectedMenuID:            INTEGER;
        ItemSelected:            INTEGER;

        BEGIN

            { Count the number of menus necessary.  Limit it to MaxTotalMenus.}
            TotalNumberOfMenus := NumberOfLinesInPtr(MenuItems);
            IF TotalNumberOfMenus > MaxTotalMenus THEN TotalNumberOfMenus := MaxTotalMenus;

            { Call NewMenu to make all of the required menus.}

            FOR MenuIndex := 1 to TotalNumberOfMenus DO
                TheMenus[MenuIndex] := NewMenu(FirstMenuID + MenuIndex - 1,'');

            { Append the items in the appropriate line to their corresponding menu.}

            NextItemsLine := MenuItems;
            FOR MenuIndex := 1 to TotalNumberOfMenus DO
            BEGIN
                AppendFirstLineMenuItemsPtr(TheMenus[MenuIndex], NextItemsLine);
                NextItemsLine := BeginningOfNextLine(NextItemsLine);
                IF StringLength(ParamPtr, NextItemsLine) < 1 THEN Leave;
            END;

            { Attach each submenu with 1 or more item to its spot in the top menu. }

            FOR MenuIndex := 2 to TotalNumberOfMenus DO
            BEGIN
                IF (CountMItems(TheMenus[MenuIndex]) > 0) THEN
                BEGIN
                    SetItemCmd(TheMenus[1], MenuIndex - 1, char($1B));
                    SetItemMark(TheMenus[1], MenuIndex - 1, char(FirstMenuID + MenuIndex - 1))
                END
            END;

            { Insert all of the menus into the menus list. }
            FOR MenuIndex := 1 to TotalNumberOfMenus DO
                InsertMenu(TheMenus[MenuIndex], -1);

            { Do the popup }
            PopUpResult := PopUpMenuSelect(TheMenus[1], Top, Left, InitialItem);
            SelectedMenuID := HiWord(PopUpResult);
            ItemSelected := LoWord(PopUpResult);

            IF (SelectedMenuID <> 0) THEN
                BEGIN
                    FirstLevelSelection := SelectedMenuID - FirstMenuID;
                    SecondLevelSelection := ItemSelected
                END
            ELSE
                BEGIN
                    FirstLevelSelection := ItemSelected;
                    SecondLevelSelection := 0
                END;

            { Delete the menus from the menu list.}
            FOR MenuIndex := 1 to TotalNumberOfMenus DO
                DeleteMenu(FirstMenuID + MenuIndex - 1);

            { Dispose of the menu and all submenus. }
            FOR MenuIndex := 1 to TotalNumberOfMenus DO
                DisposeMenu(TheMenus[MenuIndex])

        END; {DoHPopUpMenuPtr}

    BEGIN {HPopUpMenu}

        WITH paramPtr^ DO
        BEGIN

            { Parse parameters & Get Menu Position }
            MenuItems := Params[1]^;
            InitialItem := ParamToNum(Params[2]);
            GetCardWindowParams(CardWindowTop, CardWindowLeft);
            Top := CardWindowTop + ParamToNum(Params[3]);
            Left := CardWindowLeft + ParamToNum(Params[4]);

            IF (StringLength(ParamPtr, MenuItems) <> 0) THEN

                { Run the popup menu }
                DoHPopUpMenuPtr(FirstMenuID, MenuItems, InitialItem, Top, Left,
                                FirstLevelSelection, SecondLevelSelection)
            ELSE
                BEGIN
                    FirstLevelSelection := 0;
                    SecondLevelSelection := 0
                END;

            NumToStr(ParamPtr, FirstLevelSelection, FirstLevelString);
            NumToStr(ParamPtr, SecondLevelSelection, SecondLevelString);

            { Return the selection }
            ExitWithMessage(concat(FirstLevelString, ',', SecondLevelString))

        END

    END { HPopUpMenu } ;

END. { DummyUnit }